Com ajuda do tidytuesday
A análise de dados tem por objetivo transformar informação em insights e soluções, não necessariamente envolve modelagem, mas gosto muito desta visão do ciclo da análise de dados:
:::footer Créditos da imagem Allison Horst. :::
A base de hoje se chama hotels, compartilhada pelo Tidytuesday em 2020. Tidytuesday é um projeto que lança semanalmente bases de dados reais. Organizado pela comunidade R4DS.
Quando a base de dados está disponível em algum repositório público do github, podemos carregar assim:
Um problema comum que podemos encontrar é ter de carregar uma base de dados local muito grande, neste caso, uma boa saída seria utilizar data.table
Primeiramente, precisamos conhecer a base,
Para a versão prática, vamos utilizar a função skim do pacote skimr, para obtermos um overview.
Lidar com dados vazios, inputs errados e muitas NAs, geralmente levam a:
Contato com o fornecedor dos dados (pode ser interno, caso exista um time de administração de banco de dados, ou data engineering), para entender a possibilidade de correção.
Remoção das colunas ou linhas afetadas (preencher dados faltantes não é algo muito utilizado na prática, por ser arriscado)
Considerar apenas as estadias que de fato aconteceram pois nosso objetivo na análise envolve os hóspedes com filhos.
Chegou a hora de fazer perguntas para os dados.
hotel_stays |>
mutate(arrival_date_month = factor(arrival_date_month,
levels = month.name
)) |>
count(hotel, arrival_date_month, children) |>
group_by(hotel, children) |>
mutate(proportion = n / sum(n)) |>
ggplot(aes(arrival_date_month, proportion, fill = children)) +
geom_col(position = "dodge") +
scale_y_continuous(labels = scales::percent_format()) +
facet_wrap(~hotel, nrow = 2) +
labs(
x = NULL,
y = "Proporção de estadia ao longo do ano",
fill = NULL
)hotel_stays |>
count(hotel, required_car_parking_spaces, children) |>
group_by(hotel, children) |>
mutate(proportion = n / sum(n)) |>
ggplot(aes(required_car_parking_spaces, proportion, fill = children)) +
geom_col(position = "dodge") +
scale_y_continuous(labels = scales::percent_format()) +
facet_wrap(~hotel, nrow = 2) +
labs(
x = NULL,
y = "Proporção de estadia",
fill = NULL
)+
ggtitle("Proporção de acordo com solicitação de vagas e presença de crianças")df_processed <- hotels |>
filter(is_canceled == 0) |>
mutate(
parents = if_else(children > 0 | babies > 0, 1, 0),
parents_detailed = case_when(children > 0 ~ "pais",
babies > 0 ~ "pais_jovens",
TRUE ~ "sem_filhos"),
meal_num = if_else(meal %in% c("HB", "FB"), 1, 0)
) |>
dplyr::select(parents_detailed,# not_canceled,
stays_in_weekend_nights,
meal_num, total_of_special_requests) |>
pivot_longer(cols = stays_in_weekend_nights:total_of_special_requests,
names_to = "variable",
values_to = "value") |>
group_by(parents_detailed, variable) |>
summarize(
yes = sum(value > 0) / n(),
no = sum(value == 0) / n()
) |>
pivot_longer(cols = c(yes, no),
names_to = "group",
values_to = "value")|>
filter(group == "yes")Características de hospedagem
# Paletas de cores simplificadas
color_fill <- c("young_parents" = "#66c2a5", "parents" = "#fc8d62", "no_parents" = "#8da0cb")
ggplot(df_processed , aes(x = variable, y = value, fill = parents_detailed)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = color_fill) +
scale_alpha_manual(0.6) +
labs(title = "Comparação de característica de hospedagem",
x = "Características",
y = "%",
fill = "tem filhos?",
alpha = "Type of Parent") +
theme_minimal()Características de hospedagem
Ggpairs nos ajuda a analisar de modo geral o que tem correlação com a presença de crianças
colocar mais info que possa passar insights
primeiramente, quais são as variáveis mais relacionadas com a variável resposta?
Selecionar as colunas mais importantes para a variável resposta e transformar as categóricas em fator (boa prática).
set.seed(2023)
#particionar os dados em treino e teste
hotel_split <- initial_split(hotels_df)
hotel_train <- training(hotel_split)
hotel_test <- testing(hotel_split)
# Cria uma "receita" para o pré-processamento dos dados.
# Estamos tentando prever a variável 'children' com base em todas as outras variáveis (denotadas por '.') no conjunto de dados 'hotel_train'.
hotel_rec <- recipe(children ~ ., data = hotel_train) %>%
# método de subamostragem para balancear a variável de resposta 'children'.
themis::step_downsample(children) %>%
# Converte todas as variáveis nominais (categóricas) em variáveis dummy (ou binárias), exceto a variável de resposta.
# Por exemplo, uma variável categórica com níveis 'A', 'B', e 'C' será convertida em três novas variáveis binárias.
step_dummy(all_nominal(), -all_outcomes()) %>%
# Remove qualquer variável numérica que tenha um único valor (variância zero) em todas as observaçõesjá que tais variáveis não adicionam informações úteis ao modelo.
step_zv(all_numeric()) %>%
# Normaliza todas as variáveis numéricas para que tenham média 0 e desvio padrão 1.
# Isso ajuda em muitos algoritmos de aprendizado de máquina que são sensíveis à escala das variáveis.
step_normalize(all_numeric()) %>%
# Prepara a receita aplicando todas as etapas definidas acima.
prep()
hotel_recknn_spec <- nearest_neighbor() %>%
set_engine("kknn") %>%
set_mode("classification")
knn_fit <- knn_spec %>%
fit(children ~ ., data = juice(hotel_rec))
knn_fitparsnip model object
Call:
kknn::train.kknn(formula = children ~ ., data = data, ks = min_rows(5, data, 5))
Type of response variable: nominal
Minimal misclassification: 0.2582767
Best kernel: optimal
Best k: 5
validation_splits <- mc_cv(juice(hotel_rec), prop = 0.9, strata = children)
knn_wf <- workflow() |>
add_model(knn_spec) |>
add_formula(children ~.)
knn_res <- fit_resamples(
knn_wf,
validation_splits,
control = control_resamples(save_pred = TRUE)
)
knn_res %>%
collect_metrics()# A tibble: 2 × 6
.metric .estimator mean n std_err .config
<chr> <chr> <dbl> <int> <dbl> <chr>
1 accuracy binary 0.732 25 0.00228 Preprocessor1_Model1
2 roc_auc binary 0.797 25 0.00263 Preprocessor1_Model1
tree_spec <- decision_tree() %>%
set_engine("rpart") %>%
set_mode("classification")
tree_fit <- tree_spec %>%
fit(children ~ ., data = juice(hotel_rec))
tree_fitparsnip model object
n= 9122
node), split, n, loss, yval, (yprob)
* denotes terminal node
1) root 9122 4561 children (0.50000000 0.50000000)
2) adr>=0.1530954 3366 753 children (0.77629234 0.22370766) *
3) adr< 0.1530954 5756 1948 none (0.33842946 0.66157054)
6) total_of_special_requests>=0.6533096 1174 519 children (0.55792164 0.44207836)
12) adr>=-0.3665328 532 173 children (0.67481203 0.32518797) *
13) adr< -0.3665328 642 296 none (0.46105919 0.53894081) *
7) total_of_special_requests< 0.6533096 4582 1293 none (0.28219118 0.71780882)
14) adults< -2.894676 79 5 children (0.93670886 0.06329114) *
15) adults>=-2.894676 4503 1219 none (0.27070842 0.72929158) *
tree_wf <- workflow() |>
add_model(tree_spec) |>
add_formula(children ~.)
tree_res <- fit_resamples(
tree_wf,
validation_splits,
control = control_resamples(save_pred = TRUE)
)
tree_res %>%
collect_metrics()# A tibble: 2 × 6
.metric .estimator mean n std_err .config
<chr> <chr> <dbl> <int> <dbl> <chr>
1 accuracy binary 0.729 25 0.00300 Preprocessor1_Model1
2 roc_auc binary 0.752 25 0.00321 Preprocessor1_Model1
knn_res %>%
unnest(.predictions) %>%
mutate(model = "kknn") %>%
bind_rows(tree_res %>%
unnest(.predictions) %>%
mutate(model = "rpart")) %>%
group_by(model) %>%
roc_curve(children, .pred_children) %>%
ggplot(aes(x = 1 - specificity, y = sensitivity, color = model)) +
geom_line(size = 1.5) +
geom_abline(
lty = 2, alpha = 0.5,
color = "gray50",
size = 1.2
)R-Ladies theme for Quarto Presentations. Code available on GitHub.